home *** CD-ROM | disk | FTP | other *** search
/ SPACE 1 / SPACE - Library 1 - Volume 1.iso / program / 363 / xlisp20 / xlisplsp / pprint.lsp < prev    next >
Text File  |  1990-02-03  |  1KB  |  41 lines
  1. ; PPRINT.LSP for XLisp Version 1.5b -- public-domain pretty-printing
  2. ;  function.  Modified from original Usenet posting; author unknown.
  3.  
  4.  
  5. (defun pp (&rest args)
  6.   (apply 'pp-aux args)
  7.   (terpri)
  8.   nil)
  9.  
  10. (defun pp-aux (expr &optional sink indent &aux moreindent newlineflag)
  11.   (or indent (setq indent 0))
  12.   (or sink (setq sink *standard-output*))
  13.   (setq moreindent 0)
  14.   (princ "(" sink)
  15.   (setq indent (1+ indent))
  16.   (do ((tail expr (cdr tail)))
  17.       ((null tail))
  18.       (cond ((atom (car tail))
  19.              (cond (newlineflag (setq moreindent 0)))
  20.              (prin1 (car tail)
  21.               sink)
  22.              (setq moreindent (+ moreindent 1 (flatc (car tail))))
  23.              (cond ((cdr tail)
  24.                     (spaces 1 sink)))
  25.              (setq newlineflag nil))
  26.             (t (cond (newlineflag (spaces moreindent sink)))
  27.                (pp-aux (car tail)
  28.                 sink (+ indent moreindent))
  29.                (cond ((cdr tail)
  30.                       (terpri sink)
  31.                       (spaces indent sink)))
  32.                (setq newlineflag t))))
  33.   (princ ")" sink)
  34.   nil)
  35.  
  36. (defun spaces (n &optional sink)
  37.   (or sink (setq sink *standard-output*))
  38.   (dotimes (i n)
  39.            (princ " " sink)))
  40.  
  41. əəəəəəəəəəəəəəəəəəəəə